c###findf.for
      SUBROUTINE FINDF(K)
C--------------------------------
C
C     THIS ROUTINE DOES AREA COVERAGE FOR A SPECIFIED FREQUENCY
C     (FIND ALL MODES FOR AN OPERATING FREQUENCY)
C     INSERTS PENETRATION ANGLES INTO THE ANGLE TABLE AND COMPUTES ALL
C     RAY PATH PARAMETERS FOR EACH ANGLE AT THE FREQUENCY "FREQ"
C
C     FREQ  GIVEN OPERATING FREQUENCY  - MHZ-
C     GHOP  GIVEN GROUND DISTANCE -RADIANS-
C     DELPEN(3,5) PENETRATION ANGLE FOR FREQUENCY FMHZ -DEGREES-
C
C
C     DELMOD(6,5)  TAKE OFF ANGLE AT FMHZ,GHOP -DEGREES-
C     HPMOD (6,5)  VIRTUAL HEIGHT AT FMHZ,GHOP -KM-
C     HTMOD (6,5)  TRUE    HEIGHT AT FMHZ,GHOP -KM-
C     DSKPKM       SKIP DISTANCE AT FMHZ,GHOP -KM-
C     DELSKP       TAKE OFF ANGLE FOR SKIP DISTANCE -DEGREES-
C     HPSKP        VIRTUAL HEIGHT FOR SKIP DISTANCE -KM-
C     HTSKP        TRUE    HEIGHT FOR SKIP DISTANCE -KM-
C     NANG IS THE HIGHEST ANGLE NUMBER (PRESET IN SUBROUTINE SANG)
C
 
C     K IS THE SAMPLE AREA
C     ICUSP IS THE INSERT CUSP INDEX
C     (=-1 FOR NOT IN, =0 FOR ONE SIDE IN, =1 FOR FINISHED)
C     IH IS THE HEIGHT INDEX FOR COMMON/RAYS/ (FROM 1 TO 30)
C     ILOW IS THE LOWER LIMIT (IH) FOR LAYER
C     IHIGH IS THE UPPER LIMIT (IH) FOR LAYER
C     IA IS THE ANGLE INDEX FOR COMMON/RAYS/ (1 TO NANG .LE. 40)
C     IAF IS THE ANGLE INDEX FOR COMMON/REFLX/ (1 TO 45)
C     IFOB IS IN KHZ
C
C  LONG PATH PARAMETERS,SEE SUBR LNGPAT.
      COMMON /DON /ALATD, AMIN, AMIND, BTR, BTRD, DLONG, DMP, ERTR, GCD,
     1 GCDKM, PMP, PWR, TLAT, TLATD, TLONG, TLONGD, RSN, SIGTR, RLAT,
     2 RLATD,RLONG,RLONGD,BRTD,FLUX,ULAT,ULATD,ULONG,ULONGD,SSN,D90R,
     3 D50R,D10R,D90S,D50S,D10S
      COMMON/FRQ/FREA(13),FREL(29),FREQ,JMODE,ITXRCP(2)
      COMMON/REFLX/DELFX(45,3),HPFLX(45,3),HTFLX(45,3),GDFLX(45,3),FVFLX
     A (45,3),DSKPKM(3),DELSKP(3),HPSKP(3),HTSKP(3),DMAXKM(3),FVSKP(3)
     B ,ISKP(3),IMODE(45,3),AFFLX(45,3),DELPEN(3,5),GML(45,3),FHP(45,3)
      COMMON/LOSX/ANDVX(45,3),ADVX(45,3),AOFX(45,3),ARFX(45,3),GRLOSX(45
     A ,3),TGAINX(45,3),TLSKM(45,3),EFFlp(45),IAFTXR(3)
      COMMON /CON /D2R, DCL, GAMA, PI, PI2, PIO2, R2D, RZ, VOFL
      COMMON /RON /CLAT(5), CLONG(5), GLAT(5), RD(5), FI(3,5), YI(3,5),
     1HI(3,5), HPRIM(30,5), HTRUE(30,5), FVERT(30,5),KM,KFX, AFAC(30,5),
     2HTR(50,3), FNSQ(50,3)
      COMMON/INFORM/INFO,IHSHR,IHLNG
      COMMON/RAYS/ANG(40),IFOB(40,30,5),NANG
      DIMENSION ITYPE(3)
      CHARACTER ITF*1
      DATA ITYPE/1,2,3/
      JFHZ = 1000. * FREQ
      DMAXKM (K) = 0.
      DSKPKM (K) = 10000.
      DO 100 IA = 1, 45
      HPFLX (IA, K) = 0.
      DELFX (IA,K) = 0.
  100 GDFLX (IA, K) = 0.
      FC2 = FI (3, K) * FI (3, K)
C
C     FIND PENETRATION ANGLES
C
      CALL PENANG(K)
      ITF=CHAR(12)
      IF(IAND(INFO,32).GT.0.OR.IAND(INFO,8).GT.0)THEN
      WRITE(99,'(A1,/,/,18X,8H  FREQ  ,F7.3,8H   NANG ,I4,8H  AMIND ,
     1 F6.2,/,31X,12HCONTROL AREA,I4,/,16X,20HPENETRATION ANGLES  ,
     2 3F8.3)')ITF,FREQ,NANG,AMIND,K,(delpen(ia,k),ia=1,3)
      WRITE(99,'(/,A,A,/)')'  IDX  CUSP  DISTANCE  ANGLE V',
     1'IRTUAL M.CORR   TRUE  MODE  FVERT COLL-ADJ'
      ENDIF
      IA = 0
      IAF = 1
C
C     SET  LAYER
C
C.....SET FOR E LAYER
      ICUSP = - 1
      IL = 1
      IH = 1
      ILOW = 1
      IHIGH = 10
      GO TO 275
C.....SET FOR F LAYER
  225 IH = 11
      ILOW = 11
      IF (FI (2, K))235, 235, 245
C.....SET FOR F2 LAYER ONLY
  235 IL = 3
      ICUSP = - 1
      IHIGH = 30
  236 CONTINUE
      GO TO 275
C.....SET FOR F1 LAYER
  245 IL = 2
      ICUSP = - 1
      IHIGH = 20
      GO TO 236
C.....SET FOR F2 LAYER
  255 IL = 3
      ICUSP = - 1
      ILOW = IHIGH + 1
      IHIGH = 30
      IH = 21
      GO TO 236
  265 GO TO (225, 255, 400), IL
C.....START OF SEARCH
  275 CONTINUE
C.....CHECK TO SEE IF ANY MODES FROM THIS LAYER
      IF (DELPEN (IL, K))265, 265, 285
C.....CHECK IF PENETRATED ALL LAYERS
  285 IF (DELPEN (IL, K) - 89.99)295, 295, 400
C.....INCREMENT ANGLE
  295 IA = IA + 1
C.....STOP IF THERE ARE MORE HOPS THAN REASONABLE
      IF(IA-NANG) 300,300,400
  300 CONTINUE
C.....CHECK TO SEE IF LAYER WAS PENETRATED
      IF (DELPEN (IL, K) - ANG (IA))345, 345, 305
C.....SEARCH FOR FREQUENCY
  305 CONTINUE
      IF(IFOB(IA,ILOW,K) - JFHZ) 306, 325, 325
  306 IF(IH - IHIGH) 315, 275, 275
  315 IF (IFOB (IA, IH, K) - JFHZ)335, 325, 330
C.....EXACT FREQUENCY TO THREE PLACES (IN MHZ)
  325 DELFX (IAF, K) = ANG (IA)
      HTFLX (IAF, K) = HTRUE (IH, K)
      AFFLX(IAF,K)=AFAC(IH,K)
      FV = FVERT (IH, K)
      HP = HPRIM (IH, K)
      IMODE (IAF, K) = ITYPE (IL)
      GO TO 375
C.....INCREMENT HEIGHT INDEX
  330 IH = IH + 1
      GO TO 305
  335 IF (IFOB (IA, IH + 1, K) - JFHZ)330, 340, 340
C.....BEGIN INTERPOLATION
  340 SLOPD = IFOB (IA, IH + 1, K) - IFOB (IA, IH, K)
      SLOPD = AMAX1 (1., SLOPD)
      SLOPE = JFHZ - IFOB (IA, IH, K)
      SLOPE = SLOPE / SLOPD
      HTFLX (IAF, K) = HTRUE (IH, K) + SLOPE * (HTRUE (IH + 1, K) - HTRU
     1E (IH, K))
      FV = FVERT (IH, K) + SLOPE * (FVERT (IH + 1, K) - FVERT (IH, K))
      DELFX (IAF, K) = ANG (IA)
      HP = HPRIM (IH, K) + SLOPE * (HPRIM (IH + 1, K) - HPRIM (IH, K))
      AFFLX (IAF, K) = AFAC (IH, K) + SLOPE * (AFAC (IH + 1, K) - AFAC (
     1IH, K))
      IMODE (IAF, K) = ITYPE (IL)
C.....END INTERPOLATION
      GO TO 375
C.....BEGIN INSERT OF CUSP
  345 DELFX (IAF, K) = DELPEN (IL, K)
      HTFLX (IAF, K) = HTRUE (IHIGH, K)
      AFFLX( IAF,K ) = AFAC( IHIGH, K)
      FV = FVERT (IHIGH, K)
      HP = HPRIM (IHIGH, K)
C.....KEEP ANGLE COUNT CORRECT
      IA = IA - 1
      ICUSP = 0
      IMODE (IAF, K) = ITYPE (IL)
C.....END OF INSERT CUSP
      GO TO 375
C.....F2 IS THE LAST LAYER
  350 IF (IL - 3)355, 400, 400
C.....IS NEXT LAYER POSSIBLE
C
C.....BEGIN INSERT CUSP FOR NEXT LAYER
  355 IF (DELPEN (IL, K) - 89.9)360, 400, 400
  360 DELFX (IAF, K) = DELFX (IAF - 1, K) + .001
      HTFLX (IAF, K) = HTRUE (IHIGH + 1, K)
      AFFLX(IAF,K) = AFAC(IHIGH+1,K)
      FV = FVERT (IHIGH + 1, K)
      HP = HPRIM (IHIGH + 1, K)
      ICUSP = 1
      IF (FI (2, K))365, 365, 370
  365 IMODE (IAF, K) = ITYPE (3)
      GO TO 375
  370 IMODE (IAF, K) = ITYPE (IL + 1)
C.....END OF INSERT CUSP FOR NEXT LAYER
  375 CONTINUE
C  CORRECT MARTYN S THEOREM
C.....MARTYN"S THEOREM ASSUMES FLAT IONOSPHERE
C.....THIS IS A CORRECTION FOR A SPHERICAL IONOSPHERE
      DEL = DELFX (IAF, K) * D2R
      RCOSD = RZ * COS (DEL)
      XFSQ = FREQ * FREQ / FC2
      HT = HTFLX (IAF, K)
      XMUT = 1. - FV * FV / (FREQ * FREQ)
      XHP = (HP - HT) / RZ
      SPH = XFSQ * XMUT * XHP * (HT + 2. * (RZ + HT) * XHP)
c.....SPH=amin1(SPH,60.)
CANCEL      IF(IAND(INFO,8).GT.0)THEN
CANCEL        WRITE(99,'(2(A,I2),3(A,F7.2))')' "FINDF" LAYER=',IL,
CANCEL     1'  IAF=',IAF,'  FREQ=',FREQ,'  HP=',HP,'  MARTYN CORR=',SPH
CANCEL      ENDIF
      HP = HP + SPH
      PHE = RCOSD / (RZ + HP)
      PHE = ASIN (PHE)
      GDR = 2. * RZ * (PIO2 - DEL - PHE)
C.....GROUND DISTANCE (KM)
      GDFLX (IAF, K) = GDR
      HPFLX (IAF, K) = HP
      FVFLX (IAF, K) = FV
C.....BEGIN TO FIND SKIP DISTANCE (MINIMUM)
      IF (DSKPKM (K) - GDR)385, 385, 380
  380 DSKPKM (K) = GDR
      DELSKP (K) = DELFX (IAF, K)
      HTSKP (K) = HT
      HPSKP (K) = HP
      FVSKP (K) = FV
      ISKP (K) = ITYPE (IL)
      SKPSPH=SPH
      ICUSPSKP=ICUSP
C.....END OF FINDING SKIP DISTANCE
  385 IF (DMAXKM (K) -  GDR)390, 390, 395
  390 IF(DELFX(IAF,K)  - AMIND ) 395,391,391
C.....FIND MAXIMUM DISTANCE
  391 DMAXKM(K) = GDR
      ICUSPMAX=ICUSP
  395 CONTINUE
C.....INCREMENT INDEX FOR COMMON/REFLX/ (MAXIMUM IS 45)
      IF(IAND(INFO,32).GT.0.OR.IAND(INFO,8).GT.0)THEN
      WRITE(99,'(2I5,F11.1,F7.2,F8.2,F6.2,F9.2,I4,F8.3,F7.2))')IAF,
     1 ICUSP,GDFLX(IAF,K),DELFX(IAF,K),HPFLX(IAF,K),SPH,HTFLX(IAF,K),
     2 IMODE(IAF,K),FVFLX(IAF,K),AFFLX(IAF,K)
      ENDIF
      IAFTXR(K)=IAF
      IAF = IAF + 1
      IF(IAF - 45) 396, 396, 400
  396 IF(ICUSP) 275, 350, 265
  400 CONTINUE
C.....END OF INSERT CUSP  (IE CUSP FINISHED)
      IF(IAND(INFO,32).GT.0.OR.IAND(INFO,8).GT.0)THEN
      WRITE(99,'(/,5H SKIP,I5,F11.1,F7.2,F8.2,F6.2,F9.2,I4,F8.3,/,A,
     1 I5,F11.1)')ICUSPSKP,DSKPKM(K),DELSKP(K),HPSKP(K),SKPSPH,HTSKP(K),
     2 ISKP(K),FVSKP(K),' MAX ',ICUSPMAX,DMAXKM(K)
      ENDIF
      RETURN
      END
C--------------------------------
